MODULE ModtuvDriver

  LOGICAL :: no2Present,so2Present
  INTEGER :: iPosNo2,iPosSo2
  LOGICAL :: tuvDriverInit
      
  REAL,PARAMETER,DIMENSION(33,9,6) :: mcdat=RESHAPE((/ &
      0.000000E+00,0.100000E+04,0.200000E+04,0.300000E+04, & !
      0.400000E+04,0.500000E+04,0.600000E+04,0.700000E+04, & !
      0.800000E+04,0.900000E+04,0.100000E+05,0.110000E+05, & !
      0.120000E+05,0.130000E+05,0.140000E+05,0.150000E+05, & !
      0.160000E+05,0.170000E+05,0.180000E+05,0.190000E+05, & !
      0.200000E+05,0.210000E+05,0.220000E+05,0.230000E+05, & !
      0.240000E+05,0.250000E+05,0.300000E+05,0.350000E+05, & !
      0.400000E+05,0.450000E+05,0.500000E+05,0.700000E+05, & !
      0.103000E+06,0.000000E+00,0.100000E+04,0.200000E+04, & !
      0.300000E+04,0.400000E+04,0.500000E+04,0.600000E+04, & !
      0.700000E+04,0.800000E+04,0.900000E+04,0.100000E+05, & !
      0.110000E+05,0.120000E+05,0.130000E+05,0.140000E+05, & !
      0.150000E+05,0.160000E+05,0.170000E+05,0.180000E+05, & !
      0.190000E+05,0.200000E+05,0.210000E+05,0.220000E+05, & !
      0.230000E+05,0.240000E+05,0.250000E+05,0.300000E+05, & !
      0.350000E+05,0.400000E+05,0.450000E+05,0.500000E+05, & !
      0.700000E+05,0.104000E+06,0.000000E+00,0.100000E+04, & !
      0.200000E+04,0.300000E+04,0.400000E+04,0.500000E+04, & !
      0.600000E+04,0.700000E+04,0.800000E+04,0.900000E+04, & !
      0.100000E+05,0.110000E+05,0.120000E+05,0.130000E+05, & !
      0.140000E+05,0.150000E+05,0.160000E+05,0.170000E+05, & !
      0.180000E+05,0.190000E+05,0.200000E+05,0.210000E+05, & !
      0.220000E+05,0.230000E+05,0.240000E+05,0.250000E+05, & !
      0.300000E+05,0.350000E+05,0.400000E+05,0.450000E+05, & !
      0.500000E+05,0.700000E+05,0.103000E+06,0.000000E+00, & !
      0.100000E+04,0.200000E+04,0.300000E+04,0.400000E+04, & !
      0.500000E+04,0.600000E+04,0.700000E+04,0.800000E+04, & !
      0.900000E+04,0.100000E+05,0.110000E+05,0.120000E+05, & !
      0.130000E+05,0.140000E+05,0.150000E+05,0.160000E+05, & !
      0.170000E+05,0.180000E+05,0.190000E+05,0.200000E+05, & !
      0.210000E+05,0.220000E+05,0.230000E+05,0.240000E+05, & !
      0.250000E+05,0.300000E+05,0.350000E+05,0.400000E+05, & !
      0.450000E+05,0.500000E+05,0.700000E+05,0.104000E+06, & !
      0.000000E+00,0.100000E+04,0.200000E+04,0.300000E+04, & !
      0.400000E+04,0.500000E+04,0.600000E+04,0.700000E+04, & !
      0.800000E+04,0.900000E+04,0.100000E+05,0.110000E+05, & !
      0.120000E+05,0.130000E+05,0.140000E+05,0.150000E+05, & !
      0.160000E+05,0.170000E+05,0.180000E+05,0.190000E+05, & !
      0.200000E+05,0.210000E+05,0.220000E+05,0.230000E+05, & !
      0.240000E+05,0.250000E+05,0.300000E+05,0.350000E+05, & !
      0.400000E+05,0.450000E+05,0.500000E+05,0.700000E+05, & !
      0.103000E+06,0.000000E+00,0.100000E+04,0.200000E+04, & !
      0.300000E+04,0.400000E+04,0.500000E+04,0.600000E+04, & !
      0.700000E+04,0.800000E+04,0.900000E+04,0.100000E+05, & !
      0.110000E+05,0.120000E+05,0.130000E+05,0.140000E+05, & !
      0.150000E+05,0.160000E+05,0.170000E+05,0.180000E+05, & !
      0.190000E+05,0.200000E+05,0.210000E+05,0.220000E+05, & !
      0.230000E+05,0.240000E+05,0.250000E+05,0.300000E+05, & !
      0.350000E+05,0.400000E+05,0.450000E+05,0.500000E+05, & !
      0.700000E+05,0.104000E+06,0.000000E+00,0.100000E+04, & !
      0.200000E+04,0.300000E+04,0.400000E+04,0.500000E+04, & !
      0.600000E+04,0.700000E+04,0.800000E+04,0.900000E+04, & !
      0.100000E+05,0.110000E+05,0.120000E+05,0.130000E+05, & !
      0.140000E+05,0.150000E+05,0.160000E+05,0.170000E+05, & !
      0.180000E+05,0.190000E+05,0.200000E+05,0.210000E+05, & !
      0.220000E+05,0.230000E+05,0.240000E+05,0.250000E+05, & !
      0.300000E+05,0.350000E+05,0.400000E+05,0.450000E+05, & !
      0.500000E+05,0.700000E+05,0.103000E+06,0.000000E+00, & !
      0.100000E+04,0.200000E+04,0.300000E+04,0.400000E+04, & !
      0.500000E+04,0.600000E+04,0.700000E+04,0.800000E+04, & !
      0.900000E+04,0.100000E+05,0.110000E+05,0.120000E+05, & !
      0.130000E+05,0.140000E+05,0.150000E+05,0.160000E+05, & !
      0.170000E+05,0.180000E+05,0.190000E+05,0.200000E+05, & !
      0.210000E+05,0.220000E+05,0.230000E+05,0.240000E+05, & !
      0.250000E+05,0.300000E+05,0.350000E+05,0.400000E+05, & !
      0.450000E+05,0.500000E+05,0.700000E+05,0.103000E+06, & !
      0.000000E+00,0.100000E+04,0.200000E+04,0.300000E+04, & !
      0.400000E+04,0.500000E+04,0.600000E+04,0.700000E+04, & !
      0.800000E+04,0.900000E+04,0.100000E+05,0.110000E+05, & !
      0.120000E+05,0.130000E+05,0.140000E+05,0.150000E+05, & !
      0.160000E+05,0.170000E+05,0.180000E+05,0.190000E+05, & !
      0.200000E+05,0.210000E+05,0.220000E+05,0.230000E+05, & !
      0.240000E+05,0.250000E+05,0.300000E+05,0.350000E+05, & !
      0.400000E+05,0.450000E+05,0.500000E+05,0.700000E+05, & !
      0.103000E+06,0.101350E+06,0.884160E+05,0.772130E+05, & !
      0.672740E+05,0.584310E+05,0.505830E+05,0.436400E+05, & !
      0.375200E+05,0.321710E+05,0.274350E+05,0.233980E+05, & !
      0.199510E+05,0.170080E+05,0.144900E+05,0.123380E+05, & !
      0.104990E+05,0.892900E+04,0.759000E+04,0.645000E+04, & !
      0.547500E+04,0.464800E+04,0.394500E+04,0.334900E+04, & !
      0.284300E+04,0.241400E+04,0.205000E+04,0.905100E+03, & !
      0.417100E+03,0.199000E+03,0.988000E+02,0.508000E+02, & !
      0.350000E+01,0.100000E+00,0.101250E+06,0.895020E+05, & !
      0.790200E+05,0.696710E+05,0.612500E+05,0.536670E+05, & !
      0.468620E+05,0.407780E+05,0.353490E+05,0.305250E+05, & !
      0.262610E+05,0.225980E+05,0.194600E+05,0.167700E+05, & !
      0.124690E+05,0.107520E+05,0.927300E+04,0.799900E+04, & !
      0.689800E+04,0.595000E+04,0.523200E+04,0.442800E+04, & !
      0.381900E+04,0.329500E+04,0.284500E+04,0.245900E+04, & !
      0.119800E+04,0.591000E+03,0.304000E+03,0.161800E+03, & !
      0.882000E+02,0.630000E+01,0.100000E+00,0.101300E+06, & !
      0.887800E+05,0.777500E+05,0.679800E+05,0.593200E+05, & !
      0.515800E+05,0.446700E+05,0.385300E+05,0.330800E+05, & !
      0.282900E+05,0.241800E+05,0.206700E+05,0.176600E+05, & !
      0.151000E+05,0.129100E+05,0.110300E+05,0.943100E+04, & !
      0.805800E+04,0.688200E+04,0.587500E+04,0.501400E+04, & !
      0.427700E+04,0.364700E+04,0.310900E+04,0.264900E+04, & !
      0.225600E+04,0.102000E+04,0.470100E+03,0.224300E+03, & !
      0.111300E+03,0.572000E+02,0.400000E+01,0.100000E+00, & !
      0.101000E+06,0.896000E+05,0.792900E+05,0.700000E+05, & !
      0.616000E+05,0.541000E+05,0.473000E+05,0.413000E+05, & !
      0.359000E+05,0.310700E+05,0.267700E+05,0.230000E+05, & !
      0.197700E+05,0.170000E+05,0.146000E+05,0.125000E+05, & !
      0.108010E+05,0.928000E+04,0.798000E+04,0.686000E+04, & !
      0.589000E+04,0.507000E+04,0.436000E+04,0.375000E+04, & !
      0.322700E+04,0.278000E+04,0.134000E+04,0.661000E+03, & !
      0.340000E+03,0.181000E+03,0.987000E+02,0.710000E+01, & !
      0.100000E+00,0.101800E+06,0.897300E+05,0.789700E+05, & !
      0.693800E+05,0.608100E+05,0.531300E+05,0.462700E+05, & !
      0.401600E+05,0.347300E+05,0.299200E+05,0.256800E+05, & !
      0.219900E+05,0.188200E+05,0.161000E+05,0.137800E+05, & !
      0.117800E+05,0.100700E+05,0.861000E+04,0.735000E+04, & !
      0.628000E+04,0.537000E+04,0.458000E+04,0.391000E+04, & !
      0.334000E+04,0.286000E+04,0.243000E+04,0.111000E+04, & !
      0.518000E+03,0.253000E+03,0.129000E+03,0.682000E+02, & !
      0.470000E+01,0.100000E+00,0.101300E+06,0.902000E+05, & !
      0.802000E+05,0.710000E+05,0.628000E+05,0.554000E+05, & !
      0.487000E+05,0.426000E+05,0.372000E+05,0.324000E+05, & !
      0.281000E+05,0.243000E+05,0.209000E+05,0.179000E+05, & !
      0.153000E+05,0.130000E+05,0.110000E+05,0.950000E+04, & !
      0.812000E+04,0.695000E+04,0.595000E+04,0.510000E+04, & !
      0.437000E+04,0.376000E+04,0.322000E+04,0.277000E+04, & !
      0.132000E+04,0.652000E+03,0.333000E+03,0.176000E+03, & !
      0.951000E+02,0.670000E+01,0.100000E+00,0.102100E+06, & !
      0.906590E+05,0.803780E+05,0.711250E+05,0.627400E+05, & !
      0.551760E+05,0.483670E+05,0.422540E+05,0.367860E+05, & !
      0.319060E+05,0.275630E+05,0.237160E+05,0.203150E+05, & !
      0.173440E+05,0.147810E+05,0.125570E+05,0.106710E+05, & !
      0.904100E+04,0.765100E+04,0.648000E+04,0.549800E+04, & !
      0.467600E+04,0.398400E+04,0.340100E+04,0.290700E+04, & !
      0.248900E+04,0.116900E+04,0.568000E+03,0.286000E+03, & !
      0.148800E+03,0.794000E+02,0.540000E+01,0.200000E+00, & !
      0.101350E+06,0.904640E+05,0.805040E+05,0.714840E+05, & !
      0.633110E+05,0.559360E+05,0.492920E+05,0.433040E+05, & !
      0.379130E+05,0.330680E+05,0.287290E+05,0.248580E+05, & !
      0.214140E+05,0.183590E+05,0.156650E+05,0.132950E+05, & !
      0.112480E+05,0.952600E+04,0.808100E+04,0.686800E+04, & !
      0.584600E+04,0.498600E+04,0.425800E+04,0.364300E+04, & !
      0.312100E+04,0.267700E+04,0.127000E+04,0.622900E+03, & !
      0.316200E+03,0.165700E+03,0.891000E+02,0.610000E+01, & !
      0.200000E+00,0.101300E+06,0.904000E+05,0.805000E+05, & !
      0.715000E+05,0.633000E+05,0.559000E+05,0.492000E+05, & !
      0.432000E+05,0.378000E+05,0.329000E+05,0.286000E+05, & !
      0.247000E+05,0.213000E+05,0.182000E+05,0.156000E+05, & !
      0.132000E+05,0.111000E+05,0.937000E+04,0.789000E+04, & !
      0.666000E+04,0.565000E+04,0.480000E+04,0.409000E+04, & !
      0.350000E+04,0.300000E+04,0.257000E+04,0.122000E+04, & !
      0.600000E+03,0.305000E+03,0.159000E+03,0.854000E+02, & !
      0.580000E+01,0.100000E+00,0.249100E+03,0.252200E+03, & !
      0.250900E+03,0.245400E+03,0.239900E+03,0.234400E+03, & !
      0.228900E+03,0.223400E+03,0.217900E+03,0.214900E+03, & !
      0.214400E+03,0.213900E+03,0.213200E+03,0.212400E+03, & !
      0.211600E+03,0.210900E+03,0.210100E+03,0.209300E+03, & !
      0.208400E+03,0.207700E+03,0.207600E+03,0.207600E+03, & !
      0.207600E+03,0.207600E+03,0.207600E+03,0.207600E+03, & !
      0.207600E+03,0.213900E+03,0.225600E+03,0.237700E+03, & !
      0.248200E+03,0.235300E+03,0.201200E+03,0.278100E+03, & !
      0.275500E+03,0.272900E+03,0.268400E+03,0.261900E+03, & !
      0.255400E+03,0.248900E+03,0.242400E+03,0.235900E+03, & !
      0.229400E+03,0.226700E+03,0.227700E+03,0.228600E+03, & !
      0.229600E+03,0.230100E+03,0.230100E+03,0.230100E+03, & !
      0.230100E+03,0.230100E+03,0.230100E+03,0.230100E+03, & !
      0.230100E+03,0.230100E+03,0.230700E+03,0.231900E+03, & !
      0.233100E+03,0.239100E+03,0.251600E+03,0.266900E+03, & !
      0.278900E+03,0.281800E+03,0.220600E+03,0.213100E+03, & !
      0.257100E+03,0.259100E+03,0.256400E+03,0.252200E+03, & !
      0.246800E+03,0.240600E+03,0.233900E+03,0.227100E+03, & !
      0.220400E+03,0.217100E+03,0.217100E+03,0.217100E+03, & !
      0.217100E+03,0.217100E+03,0.217100E+03,0.217000E+03, & !
      0.216700E+03,0.216100E+03,0.215500E+03,0.214900E+03, & !
      0.214300E+03,0.213700E+03,0.213100E+03,0.212500E+03, & !
      0.212000E+03,0.211900E+03,0.216600E+03,0.223100E+03, & !
      0.235300E+03,0.247900E+03,0.258900E+03,0.245400E+03, & !
      0.209900E+03,0.287000E+03,0.281700E+03,0.276400E+03, & !
      0.271100E+03,0.265700E+03,0.259800E+03,0.252800E+03, & !
      0.245800E+03,0.238800E+03,0.231800E+03,0.225600E+03, & !
      0.225000E+03,0.225000E+03,0.225000E+03,0.225000E+03, & !
      0.225000E+03,0.225000E+03,0.225000E+03,0.225000E+03, & !
      0.225000E+03,0.225000E+03,0.225000E+03,0.225100E+03, & !
      0.225500E+03,0.226600E+03,0.227900E+03,0.234900E+03, & !
      0.247200E+03,0.262300E+03,0.274100E+03,0.276900E+03, & !
      0.216800E+03,0.209400E+03,0.272200E+03,0.268700E+03, & !
      0.265200E+03,0.261200E+03,0.255700E+03,0.249600E+03, & !
      0.243600E+03,0.237600E+03,0.231600E+03,0.225600E+03, & !
      0.220600E+03,0.219200E+03,0.218700E+03,0.218200E+03, & !
      0.217700E+03,0.217200E+03,0.216700E+03,0.216200E+03, & !
      0.215700E+03,0.215400E+03,0.215200E+03,0.215200E+03, & !
      0.215200E+03,0.215200E+03,0.215200E+03,0.215400E+03, & !
      0.217300E+03,0.227900E+03,0.244000E+03,0.258900E+03, & !
      0.265600E+03,0.230900E+03,0.210100E+03,0.294000E+03, & !
      0.290000E+03,0.285000E+03,0.279000E+03,0.273000E+03, & !
      0.267100E+03,0.261000E+03,0.254700E+03,0.248200E+03, & !
      0.241700E+03,0.235200E+03,0.228800E+03,0.222300E+03, & !
      0.216900E+03,0.215800E+03,0.215800E+03,0.215800E+03, & !
      0.215800E+03,0.216000E+03,0.217000E+03,0.218200E+03, & !
      0.219400E+03,0.220600E+03,0.221800E+03,0.223000E+03, & !
      0.224200E+03,0.234200E+03,0.245300E+03,0.257500E+03, & !
      0.269700E+03,0.276200E+03,0.219100E+03,0.209900E+03, & !
      0.287100E+03,0.284200E+03,0.281200E+03,0.274700E+03, & !
      0.268200E+03,0.261700E+03,0.255200E+03,0.248800E+03, & !
      0.242300E+03,0.235800E+03,0.229300E+03,0.222900E+03, & !
      0.216400E+03,0.213700E+03,0.211100E+03,0.208500E+03, & !
      0.205900E+03,0.203300E+03,0.203100E+03,0.205400E+03, & !
      0.207900E+03,0.210400E+03,0.212900E+03,0.214900E+03, & !
      0.216900E+03,0.218900E+03,0.228800E+03,0.239800E+03, & !
      0.251600E+03,0.263400E+03,0.269100E+03,0.221700E+03, & !
      0.191100E+03,0.301100E+03,0.293700E+03,0.288200E+03, & !
      0.282700E+03,0.277200E+03,0.271700E+03,0.266300E+03, & !
      0.259300E+03,0.252300E+03,0.245300E+03,0.238400E+03, & !
      0.231400E+03,0.224400E+03,0.217500E+03,0.210500E+03, & !
      0.203500E+03,0.203100E+03,0.205200E+03,0.207400E+03, & !
      0.209600E+03,0.211800E+03,0.213900E+03,0.215900E+03, & !
      0.217900E+03,0.219900E+03,0.221900E+03,0.231800E+03, & !
      0.242800E+03,0.254600E+03,0.266400E+03,0.272100E+03, & !
      0.217600E+03,0.180100E+03,0.300000E+03,0.294100E+03, & !
      0.288400E+03,0.283600E+03,0.277400E+03,0.270700E+03, & !
      0.264000E+03,0.257300E+03,0.250600E+03,0.243800E+03, & !
      0.237200E+03,0.230400E+03,0.223800E+03,0.217000E+03, & !
      0.210400E+03,0.203600E+03,0.196800E+03,0.195600E+03, & !
      0.199500E+03,0.203600E+03,0.207600E+03,0.211500E+03, & !
      0.214600E+03,0.216900E+03,0.219100E+03,0.221300E+03, & !
      0.232300E+03,0.243300E+03,0.254300E+03,0.264900E+03, & !
      0.270000E+03,0.219500E+03,0.209900E+03,0.120100E-02, & !
      0.119000E-02,0.101400E-02,0.733300E-03,0.447100E-03, & !
      0.225400E-03,0.934400E-04,0.312300E-04,0.124800E-04, & !
      0.787500E-05,0.516100E-05,0.353300E-05,0.239300E-05, & !
      0.153800E-05,0.100500E-05,0.664400E-06,0.543800E-06, & !
      0.461000E-06,0.390600E-06,0.330700E-06,0.280000E-06, & !
      0.237300E-06,0.201400E-06,0.170500E-06,0.144300E-06, & !
      0.122600E-06,0.516900E-07,0.231700E-07,0.104500E-07, & !
      0.493300E-08,0.241200E-08,0.179100E-09,0.157100E-11, & !
      0.916400E-02,0.596300E-02,0.417300E-02,0.266400E-02, & !
      0.163000E-02,0.958300E-03,0.532800E-03,0.282900E-03, & !
      0.126200E-03,0.404000E-04,0.168100E-04,0.826800E-05, & !
      0.407200E-05,0.200600E-05,0.744200E-06,0.572600E-06, & !
      0.493500E-06,0.427400E-06,0.369300E-06,0.319800E-06, & !
      0.282300E-06,0.239500E-06,0.207100E-06,0.178800E-06, & !
      0.153800E-06,0.133000E-06,0.943900E-07,0.333500E-07, & !
      0.161800E-07,0.828800E-08,0.444300E-08,0.406800E-09, & !
      0.178800E-11,0.120000E-02,0.120000E-02,0.103000E-02, & !
      0.747000E-03,0.459000E-03,0.234000E-03,0.978000E-04, & !
      0.329000E-04,0.132000E-04,0.837000E-05,0.551000E-05, & !
      0.379000E-05,0.258000E-05,0.167000E-05,0.110000E-05, & !
      0.733000E-06,0.607000E-06,0.520000E-06,0.445000E-06, & !
      0.381000E-06,0.326000E-06,0.279000E-06,0.239000E-06, & !
      0.204000E-06,0.174000E-06,0.149000E-06,0.658000E-07, & !
      0.295000E-07,0.133000E-07,0.628000E-08,0.307000E-08, & !
      0.228000E-09,0.200000E-11,0.910000E-02,0.600000E-02, & !
      0.420000E-02,0.269000E-02,0.165000E-02,0.973000E-03, & !
      0.543000E-03,0.290000E-03,0.130000E-03,0.418000E-04, & !
      0.175000E-04,0.856000E-05,0.420000E-05,0.206000E-05, & !
      0.102000E-05,0.777000E-06,0.669000E-06,0.575000E-06, & !
      0.494000E-06,0.425000E-06,0.365000E-06,0.314000E-06, & !
      0.270000E-06,0.232000E-06,0.198000E-06,0.170000E-06, & !
      0.795000E-07,0.373000E-07,0.181000E-07,0.927000E-08, & !
      0.497000E-08,0.455000E-09,0.200000E-11,0.350000E-02, & !
      0.250000E-02,0.180000E-02,0.116000E-02,0.690000E-03, & !
      0.378000E-03,0.189000E-03,0.857000E-04,0.350000E-04, & !
      0.160000E-04,0.750000E-05,0.444000E-05,0.272000E-05, & !
      0.172000E-05,0.113000E-05,0.764000E-06,0.648000E-06, & !
      0.555000E-06,0.475000E-06,0.406000E-06,0.304000E-06, & !
      0.297000E-06,0.253000E-06,0.216000E-06,0.185000E-06, & !
      0.157000E-06,0.712000E-07,0.317000E-07,0.145000E-07, & !
      0.694000E-08,0.358000E-08,0.282000E-09,0.199000E-11, & !
      0.140000E-01,0.930000E-02,0.585000E-02,0.343000E-02, & !
      0.189000E-02,0.100000E-02,0.609000E-03,0.371000E-03, & !
      0.210000E-03,0.118000E-03,0.643000E-04,0.219000E-04, & !
      0.646000E-05,0.166000E-05,0.995000E-06,0.840000E-06, & !
      0.710000E-06,0.614000E-06,0.524000E-06,0.446000E-06, & !
      0.380000E-06,0.324000E-06,0.276000E-06,0.236000E-06, & !
      0.201000E-06,0.172000E-06,0.785000E-07,0.370000E-07, & !
      0.180000E-07,0.909000E-08,0.480000E-08,0.427000E-09, & !
      0.199000E-11,0.112500E-01,0.775000E-02,0.554500E-02, & !
      0.293000E-02,0.167500E-02,0.954000E-03,0.524500E-03, & !
      0.278300E-03,0.142500E-03,0.685000E-04,0.282500E-04, & !
      0.111700E-04,0.440000E-05,0.175500E-05,0.105800E-05, & !
      0.760500E-06,0.642500E-06,0.548500E-06,0.461500E-06, & !
      0.388000E-06,0.306000E-06,0.277000E-06,0.234500E-06, & !
      0.199500E-06,0.170000E-06,0.144000E-06,0.653500E-07, & !
      0.298000E-07,0.140500E-07,0.687000E-08,0.358000E-08, & !
      0.290500E-09,0.180500E-11,0.165000E-01,0.111500E-01, & !
      0.757000E-02,0.406500E-02,0.227500E-02,0.126500E-02, & !
      0.734500E-03,0.421000E-03,0.230000E-03,0.119500E-03, & !
      0.566500E-04,0.199000E-04,0.627000E-05,0.172500E-05, & !
      0.990500E-06,0.798500E-06,0.673500E-06,0.578000E-06, & !
      0.486000E-06,0.408000E-06,0.344000E-06,0.290500E-06, & !
      0.246000E-06,0.209500E-06,0.178000E-06,0.151500E-06, & !
      0.690000E-07,0.324500E-07,0.158000E-07,0.794500E-08, & !
      0.419000E-08,0.363000E-09,0.180500E-11,0.190000E-01, & !
      0.130000E-01,0.929000E-02,0.470000E-02,0.266000E-02, & !
      0.153000E-02,0.860000E-03,0.471000E-03,0.250000E-03, & !
      0.121000E-03,0.490000E-04,0.179000E-04,0.608000E-05, & !
      0.179000E-05,0.986000E-06,0.757000E-06,0.637000E-06, & !
      0.542000E-06,0.448000E-06,0.370000E-06,0.308000E-06, & !
      0.257000E-06,0.216000E-06,0.183000E-06,0.155000E-06, & !
      0.131000E-06,0.595000E-07,0.279000E-07,0.136000E-07, & !
      0.680000E-08,0.358000E-08,0.299000E-09,0.162000E-11, & !
      0.410500E-07,0.406700E-07,0.403600E-07,0.422100E-07, & !
      0.438400E-07,0.452700E-07,0.468100E-07,0.674000E-07, & !
      0.850800E-07,0.150500E-06,0.224800E-06,0.298300E-06, & !
      0.398800E-06,0.433000E-06,0.447700E-06,0.507600E-06, & !
      0.555400E-06,0.549700E-06,0.544200E-06,0.520800E-06, & !
      0.480900E-06,0.433700E-06,0.396100E-06,0.359400E-06, & !
      0.298600E-06,0.263300E-06,0.117800E-06,0.722700E-07, & !
      0.322100E-07,0.102100E-07,0.337800E-08,0.675600E-10, & !
      0.337800E-13,0.493500E-07,0.536600E-07,0.556400E-07, & !
      0.574300E-07,0.592600E-07,0.630300E-07,0.696600E-07, & !
      0.731600E-07,0.766800E-07,0.106300E-06,0.124900E-06, & !
      0.173900E-06,0.203600E-06,0.253200E-06,0.204300E-06, & !
      0.235800E-06,0.250800E-06,0.289900E-06,0.306500E-06, & !
      0.308500E-06,0.301600E-06,0.274600E-06,0.245400E-06, & !
      0.231200E-06,0.217600E-06,0.203500E-06,0.166200E-06, & !
      0.822500E-07,0.366600E-07,0.116200E-07,0.384400E-08, & !
      0.768900E-10,0.384400E-13,0.410000E-07,0.410000E-07, & !
      0.410000E-07,0.430000E-07,0.450000E-07,0.470000E-07, & !
      0.490000E-07,0.710000E-07,0.900000E-07,0.160000E-06, & !
      0.240000E-06,0.320000E-06,0.430000E-06,0.470000E-06, & !
      0.490000E-06,0.560000E-06,0.620000E-06,0.620000E-06, & !
      0.620000E-06,0.600000E-06,0.560000E-06,0.510000E-06, & !
      0.470000E-06,0.430000E-06,0.360000E-06,0.320000E-06, & !
      0.150000E-06,0.920000E-07,0.410000E-07,0.130000E-07, & !
      0.430000E-08,0.860000E-10,0.430000E-13,0.490000E-07, & !
      0.540000E-07,0.560000E-07,0.580000E-07,0.600000E-07, & !
      0.640000E-07,0.710000E-07,0.750000E-07,0.790000E-07, & !
      0.110000E-06,0.130000E-06,0.180000E-06,0.210000E-06, & !
      0.260000E-06,0.280000E-06,0.320000E-06,0.340000E-06, & !
      0.390000E-06,0.410000E-06,0.410000E-06,0.390000E-06, & !
      0.360000E-06,0.320000E-06,0.300000E-06,0.280000E-06, & !
      0.260000E-06,0.140000E-06,0.920000E-07,0.410000E-07, & !
      0.130000E-07,0.430000E-08,0.860000E-10,0.430000E-13, & !
      0.600000E-07,0.540000E-07,0.490000E-07,0.490000E-07, & !
      0.490000E-07,0.580000E-07,0.640000E-07,0.770000E-07, & !
      0.900000E-07,0.120000E-06,0.160000E-06,0.210000E-06, & !
      0.260000E-06,0.300000E-06,0.320000E-06,0.340000E-06, & !
      0.360000E-06,0.390000E-06,0.410000E-06,0.430000E-06, & !
      0.450000E-06,0.430000E-06,0.430000E-06,0.390000E-06, & !
      0.360000E-06,0.340000E-06,0.190000E-06,0.920000E-07, & !
      0.410000E-07,0.130000E-07,0.430000E-08,0.860000E-10, & !
      0.430000E-13,0.600000E-07,0.600000E-07,0.600000E-07, & !
      0.620000E-07,0.640000E-07,0.660000E-07,0.690000E-07, & !
      0.750000E-07,0.790000E-07,0.860000E-07,0.900000E-07, & !
      0.110000E-06,0.120000E-06,0.150000E-06,0.180000E-06, & !
      0.190000E-06,0.210000E-06,0.240000E-06,0.280000E-06, & !
      0.320000E-06,0.340000E-06,0.360000E-06,0.360000E-06, & !
      0.340000E-06,0.320000E-06,0.300000E-06,0.200000E-06, & !
      0.920000E-07,0.410000E-07,0.130000E-07,0.430000E-08, & !
      0.860000E-10,0.430000E-13,0.580000E-07,0.550000E-07, & !
      0.515000E-07,0.500000E-07,0.480000E-07,0.515000E-07, & !
      0.535000E-07,0.590000E-07,0.645000E-07,0.795000E-07, & !
      0.995000E-07,0.125500E-06,0.151500E-06,0.172500E-06, & !
      0.182500E-06,0.193500E-06,0.203500E-06,0.229500E-06, & !
      0.250000E-06,0.285000E-06,0.320000E-06,0.335000E-06, & !
      0.355000E-06,0.355000E-06,0.350000E-06,0.340000E-06, & !
      0.215000E-06,0.920000E-07,0.410000E-07,0.130000E-07, & !
      0.430000E-08,0.860000E-10,0.430000E-13,0.580000E-07, & !
      0.580000E-07,0.570000E-07,0.565000E-07,0.555000E-07, & !
      0.555000E-07,0.560000E-07,0.580000E-07,0.590000E-07, & !
      0.625000E-07,0.645000E-07,0.755000E-07,0.815000E-07, & !
      0.975000E-07,0.112500E-06,0.118500E-06,0.128500E-06, & !
      0.154500E-06,0.185000E-06,0.230000E-06,0.265000E-06, & !
      0.300000E-06,0.320000E-06,0.330000E-06,0.330000E-06, & !
      0.320000E-06,0.220000E-06,0.920000E-07,0.410000E-07, & !
      0.130000E-07,0.430000E-08,0.860000E-10,0.430000E-13, & !
      0.560000E-07,0.560000E-07,0.540000E-07,0.510000E-07, & !
      0.470000E-07,0.450000E-07,0.430000E-07,0.410000E-07, & !
      0.390000E-07,0.390000E-07,0.390000E-07,0.410000E-07, & !
      0.430000E-07,0.450000E-07,0.450000E-07,0.470000E-07, & !
      0.470000E-07,0.690000E-07,0.900000E-07,0.140000E-06, & !
      0.190000E-06,0.240000E-06,0.280000E-06,0.320000E-06, & !
      0.340000E-06,0.340000E-06,0.240000E-06,0.920000E-07, & !
      0.410000E-07,0.130000E-07,0.430000E-08,0.860000E-10, & !
      0.430000E-13,0.141700E+01,0.122100E+01,0.107200E+01, & !
      0.954900E+00,0.848500E+00,0.751800E+00,0.664300E+00, & !
      0.585200E+00,0.513900E+00,0.444800E+00,0.380200E+00, & !
      0.324900E+00,0.277900E+00,0.237600E+00,0.203100E+00, & !
      0.173500E+00,0.148100E+00,0.126400E+00,0.107800E+00, & !
      0.918500E-01,0.779700E-01,0.661900E-01,0.561900E-01, & !
      0.477000E-01,0.405000E-01,0.343900E-01,0.151900E-01, & !
      0.680400E-02,0.307500E-02,0.144900E-02,0.709400E-03, & !
      0.525900E-04,0.461700E-06,0.126500E+01,0.112900E+01, & !
      0.100700E+01,0.903000E+00,0.814100E+00,0.731700E+00, & !
      0.655800E+00,0.586100E+00,0.522100E+00,0.463600E+00, & !
      0.403600E+00,0.345800E+00,0.296500E+00,0.254400E+00, & !
      0.188700E+00,0.162800E+00,0.140400E+00,0.121100E+00, & !
      0.104400E+00,0.900700E-01,0.776900E-01,0.670200E-01, & !
      0.578100E-01,0.497600E-01,0.427400E-01,0.367400E-01, & !
      0.174600E-01,0.863100E-02,0.444200E-02,0.237100E-02, & !
      0.128800E-02,0.922700E-04,0.652500E-06,0.137200E+01, & !
      0.119300E+01,0.105800E+01,0.936600E+00,0.833900E+00, & !
      0.745700E+00,0.664600E+00,0.590400E+00,0.522600E+00, & !
      0.453800E+00,0.387900E+00,0.331500E+00,0.283400E+00, & !
      0.242200E+00,0.207100E+00,0.177000E+00,0.151700E+00, & !
      0.130000E+00,0.111300E+00,0.952900E-01,0.815500E-01, & !
      0.697600E-01,0.596600E-01,0.510000E-01,0.435800E-01, & !
      0.372200E-01,0.164500E-01,0.736800E-02,0.333000E-02, & !
      0.156900E-02,0.768200E-03,0.569500E-04,0.500000E-06, & !
      0.122000E+01,0.111000E+01,0.997100E+00,0.898500E+00, & !
      0.807700E+00,0.724400E+00,0.651900E+00,0.584900E+00, & !
      0.523100E+00,0.466300E+00,0.414200E+00,0.355900E+00, & !
      0.305900E+00,0.263000E+00,0.226000E+00,0.194300E+00, & !
      0.167100E+00,0.143600E+00,0.123500E+00,0.106200E+00, & !
      0.912800E-01,0.784900E-01,0.675000E-01,0.580500E-01, & !
      0.496300E-01,0.424700E-01,0.133800E-01,0.661400E-02, & !
      0.340400E-02,0.181700E-02,0.986800E-03,0.707100E-04, & !
      0.500000E-06,0.130100E+01,0.116200E+01,0.103700E+01, & !
      0.923000E+00,0.828200E+00,0.741100E+00,0.661400E+00, & !
      0.588600E+00,0.522200E+00,0.461900E+00,0.407200E+00, & !
      0.349600E+00,0.299900E+00,0.257200E+00,0.220600E+00, & !
      0.189000E+00,0.162000E+00,0.138800E+00,0.118800E+00, & !
      0.101700E+00,0.869000E-01,0.742100E-01,0.633800E-01, & !
      0.541500E-01,0.462400E-01,0.395000E-01,0.178300E-01, & !
      0.792400E-02,0.362500E-02,0.174100E-02,0.895400E-03, & !
      0.705100E-04,0.500000E-06,0.119100E+01,0.108000E+01, & !
      0.975700E+00,0.884600E+00,0.799800E+00,0.721100E+00, & !
      0.648700E+00,0.583000E+00,0.522500E+00,0.466900E+00, & !
      0.415900E+00,0.369300E+00,0.326900E+00,0.288200E+00, & !
      0.246400E+00,0.210400E+00,0.179700E+00,0.153500E+00, & !
      0.130500E+00,0.111000E+00,0.945300E-01,0.805600E-01, & !
      0.687200E-01,0.586700E-01,0.501400E-01,0.428800E-01, & !
      0.132200E-01,0.651900E-02,0.333000E-02,0.175700E-02, & !
      0.951200E-03,0.670600E-04,0.500000E-06,0.123300E+01, & !
      0.110700E+01,0.993400E+00,0.900600E+00,0.814200E+00, & !
      0.734000E+00,0.659900E+00,0.591600E+00,0.528900E+00, & !
      0.471300E+00,0.418700E+00,0.370700E+00,0.327000E+00, & !
      0.282800E+00,0.243900E+00,0.210100E+00,0.180500E+00, & !
      0.154900E+00,0.131100E+00,0.109900E+00,0.921300E-01, & !
      0.774300E-01,0.652000E-01,0.551200E-01,0.466900E-01, & !
      0.396100E-01,0.178000E-01,0.825500E-02,0.396000E-02, & !
      0.196700E-02,0.102700E-02,0.844000E-04,0.342200E-05, & !
      0.115900E+01,0.106600E+01,0.968600E+00,0.877600E+00, & !
      0.793700E+00,0.715900E+00,0.644300E+00,0.581400E+00, & !
      0.523300E+00,0.469400E+00,0.419800E+00,0.374200E+00, & !
      0.332400E+00,0.294100E+00,0.295300E+00,0.227600E+00, & !
      0.192900E+00,0.161700E+00,0.135800E+00,0.114200E+00, & !
      0.961800E-01,0.811900E-01,0.687000E-01,0.582300E-01, & !
      0.494400E-01,0.420300E-01,0.190900E-01,0.893900E-02, & !
      0.432700E-02,0.216700E-02,0.114000E-03,0.973900E-04, & !
      0.347200E-05,0.116700E+01,0.106400E+01,0.968900E+00, & !
      0.875600E+00,0.795100E+00,0.719900E+00,0.650100E+00, & !
      0.585500E+00,0.525800E+00,0.470800E+00,0.420200E+00, & !
      0.374000E+00,0.331600E+00,0.292900E+00,0.257800E+00, & !
      0.226000E+00,0.197200E+00,0.167600E+00,0.138200E+00, & !
      0.114500E+00,0.951500E-01,0.793800E-01,0.664500E-01, & !
      0.561800E-01,0.476300E-01,0.404500E-01,0.183100E-01, & !
      0.860000E-02,0.418100E-02,0.209700E-02,0.110100E-02, & !
      0.921000E-04,0.500000E-06/),(/33,9,6/))

   INTEGER, DIMENSION(11),PARAMETER :: latind=(/1,1,2,3,4,5,5,6,7,8,9/)
   REAL,DIMENSION(12),PARAMETER :: slat=(/ &
               -90.,-70.,-60.,-45.,-25.,-15.,15.,25.,45.,60.,70.,90./)

  !To build blocks of memory
  INTEGER :: maxblock_size
  INTEGER :: nob,iob,nOfBlock
  INTEGER,DIMENSION(:,:),ALLOCATABLE :: ijindex
  INTEGER,DIMENSION(:,:),ALLOCATABLE :: bindex         
  INTEGER,DIMENSION(:,:),ALLOCATABLE :: indexi
  INTEGER,DIMENSION(:,:),ALLOCATABLE :: indexj
  INTEGER,DIMENSION(:)  ,ALLOCATABLE :: block_end

  !If you want dump the crossreference between xy positions an blocks positions
  !please change the parameter above to .true.
  !LOGICAL,PARAMETER :: dumpXReference=.true.
  LOGICAL,PARAMETER :: dumpXReference=.false.
  INTEGER, PARAMETER :: namax=10
  INTEGER :: narad

 CONTAINS

  SUBROUTINE tuvDriver(m1,m2,m3,ia,iz,ja,jz,nstr,&
  	     wstart,wstop,nwint,nnj,jjlabel,sslabel,&
  	     rate_,valj_,sirrad_,saflux_,blockSize,listFiles)
  	     
    USE node_mod  , ONLY : mynum,mmxp,mmyp,mmzp
  
    USE rconstants, ONLY: cp,cpor,p00,rgas,g,stefan
  
    USE mem_all   , ONLY: ngrid
    USE mem_grid  , ONLY: grid_g,   &  ! glat,glon,lpw,rtgt,topt
  			   zm,      &
  			   zt,      &
  			   nnzp,    &
  			   if_adap, &
  			   dzt,     &
  			   maxnzp,  &
  			   imonth1, &
  			   idate1,  &
  			   iyear1,  &
  			   time,    &
  			   ngrids,  &
  			   dtlt
    USE mem_globrad , ONLY: nlayer,ntotal,wave,nwave,caseW,caseW_tuv
    USE mem_aerad   , ONLY: nwave
    USE mem_radiate , ONLY: radiate_g,prsnz,prsnzp  ! Surface Albedo, cosz
    USE mem_basic   , ONLY: basic_g    ! pp,pi0
    USE mem_carma   , ONLY: carma	 !aot
  			   
    USE ModTuv      , ONLY: kz,kw,ks,kj,Tuv,slabel,jlabel,nj,xRef,initTuv, &
  			   wl,wc,wu,nw,narad
    USE mem_chem1   , ONLY: chem1_g
    USE chem1_list  , ONLY: spc_name,nspecies,chemical_mechanism,O3,nr_photo
    USE ref_sounding, ONLY: pi01dn
    USE FastJX      , ONLY: fast_JX_g
    
    USE mem_tuv     , ONLY: carma_tuv,tuv2carma
   
     !tmp-srf para output 
    use extras      , ONLY:   extra3d
    
    IMPLICIT NONE
    
    INTEGER,INTENT(IN) :: m1,m2,m3,ia,iz,ja,jz
    INTEGER,INTENT(IN) :: nstr   !number of streams 
    INTEGER,INTENT(IN) :: nwint  !number of wavelength intervals. Equally spaces
    INTEGER,INTENT(IN) :: blockSize !Size of each column block
    REAL   ,INTENT(IN) :: wstart !starting wavelength [nm]
    REAL   ,INTENT(IN) :: wstop  !final wavelength [nm]
    CHARACTER(LEN=*),INTENT(IN) :: listFiles !File with list os input files
    
    !notes for the output
    ! Number of altitudes: kz
    ! Number of wavelengths: kw
    ! Number of spectral weighting functions, wavelength dependent = ks
    ! Number of photolysis coefficients, wavelength and altitude dependent = kj
    INTEGER,INTENT(OUT) :: nnj ! Photolysis coefficients (j-values)
    REAL,INTENT(OUT) :: rate_(ia:iz,ja:jz,ks,kz)  ! Weighted irradiances (dose rates) W m-2
    REAL,INTENT(OUT) :: valj_(ia:iz,ja:jz,kj,kz)  ! Photolysis coefficients (j-values)
    REAL,INTENT(OUT) :: sirrad_(ia:iz,ja:jz,kz,kw)	  ! Spectral irradiance, [W m-2 nm-1]
    REAL,INTENT(OUT) :: saflux_(ia:iz,ja:jz,kz,kw)	  ! Spectral actinic flux, quanta s-1 nm-1 cm-2
    CHARACTER(LEN=50),INTENT(OUT) :: sslabel(ks)  ! Spectral weighting functions labels
    CHARACTER(LEN=50),INTENT(OUT) :: jjlabel(kj)  ! Photolysis coefficients labels
    
    INTEGER,PARAMETER :: i550=13 !Position of 550nm on wavelength array
    REAL,PARAMETER :: dobson=2.68e+16 !Dobson units
    REAL,PARAMETER :: invDobson=1.0/dobson
    REAL,PARAMETER :: corrFactor=6.022D+23 /(48.0D0  * 1.D-3)* 1.d-4*invDobson 
    DOUBLE PRECISION,PARAMETER :: fatMUl=6.022D+23! /(1.0D-3)*1.d-4 
  
    DOUBLE PRECISION,PARAMETER :: f180PI=180.D0/3.14159270D0
    REAL, DIMENSION(ia:iz,ja:jz) :: topt,rtgt
    INTEGER :: i,j,n,k2
    REAL    :: alsurf
    REAL,DIMENSION(ia:iz,ja:jz)  :: sza_
    INTEGER :: k,m,w
    INTEGER,DIMENSION(ia:iz,ja:jz) :: k1,koff
    REAL, DIMENSION(ia:iz,ja:jz,kz) :: airDen_
    REAL, DIMENSION(ia:iz,ja:jz,kz) :: cAir_,cO3_,tcO3_,tLev_,tLay_
    REAL, DIMENSION(ia:iz,ja:jz,kz) :: dztr,z_
    REAL, DIMENSION(ia:iz,ja:jz) :: ssaaer_,zbase,ztop,tauaer_,albedo_,rshort
    REAL, DIMENSION(ia:iz,ja:jz) :: taucld,so2col_,no2col_
    REAL, DIMENSION(ia:iz,ja:jz,kz,kw) :: dtcld_,omcld_,gcld_
    REAL, DIMENSION(ia:iz,ja:jz,kz,kw) :: dtaer_,omaer_,gaer_
    
    REAL :: alpha,dirsun,difdn,difup,zhl
    !REAL :: reverse  
    LOGICAL,PARAMETER :: is2printIn =.false.!!.true.
    LOGICAL,PARAMETER :: is2printOut=.false.
    INTEGER,PARAMETER :: iCol=5
    INTEGER,PARAMETER :: jCol=5
  
    DOUBLE PRECISION:: valJLoc(ia:iz,ja:jz,kj,kz) ! Local Photolysis coefficients 
    REAL :: esfact
    CHARACTER(LEN=2) :: fname
    DOUBLE PRECISION, DIMENSION(maxnzp+namax)  :: pird, prd
    
    INTEGER :: jday, iaux,jaux,iw, ii,jj, izz
    INTEGER, DIMENSION(ia:iz,ja:jz) :: limO3
    REAL, DIMENSION(ia:iz,ja:jz,kz) :: o3_500
    LOGICAL, DIMENSION(ia:iz,ja:jz) :: limFound
    
    REAL :: w1000,solfac
    INTEGER :: maxZ,ng
    DOUBLE PRECISION, DIMENSION(ia:iz,ja:jz,maxnzp+1+namax) :: temprd
    DOUBLE PRECISION, DIMENSION(maxnzp+namax)	:: rv
    DOUBLE PRECISION, DIMENSION(ia:iz,ja:jz,maxnzp+namax)   :: do3,dair
    DOUBLE PRECISION, DIMENSION(ia:iz,ja:jz,maxnzp+namax)   :: zml,ztl,dzl
    INTEGER,DIMENSION(ia:iz,ja:jz) :: idaot
    INTEGER :: julday !External
    INTEGER :: nrad(ia:iz,ja:jz)  
    CHARACTER(LEN=4) :: cnrad,cmynum,itotj
    CHARACTER(LEN=8) :: ctime
    CHARACTER(LEN=10) :: cprnt
    INTEGER :: nReact,nrec,kvert
    LOGICAL :: is2DoTuv
    INTEGER :: indnReact(13)
  
    INTEGER, ALLOCATABLE,DIMENSION(:)	    :: nz
    REAL   , ALLOCATABLE,DIMENSION(:)	    :: sza
    REAL   , ALLOCATABLE,DIMENSION(:)	    :: so2col
    REAL   , ALLOCATABLE,DIMENSION(:)	    :: no2col
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: zLevel
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: albedo
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: tLev
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: tLay
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: airDen
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: cAir
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: cO3
    REAL   , ALLOCATABLE,DIMENSION(:,:)     :: tcO3
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: dtCld
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: omCld
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: gCld
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: dtAer
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: omAer
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: gAer
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: rate
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: valJ
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: sirRad
    REAL   , ALLOCATABLE,DIMENSION(:,:,:)   :: saFlux
    
    maxZ=maxnzp+1+namax
    
    alpha=1.0
    so2col_=0.0
    no2col_=0.0
    dirsun=1.0
    difdn=1.0
    difup=1.0
    esfact=1.0 !Considering just 1 UA for earth-sun distance (Do we must use a real value?)
    valJLoc=0.0D0
  
    jday = julday(imonth1,idate1,iyear1)
    jday = jday + nint(time/86400.)

     IF (.not. tuvDriverInit) THEN
  	no2Present=.false.;so2Present=.false.
  	
  	DO i=1,nspecies
  	   IF(trim(spc_name(i))== 'NO2') THEN
  	      iPosNo2=i
  	      no2Present=.true.
  	   END IF
  	   IF (trim(spc_name(i))=='SO2') THEN
  	      iPosSo2=i
  	      so2Present=.true.
  	   END IF
  	END DO
     
  	!Adapt lambda from carma to tuv
  	tuv2carma=1
  	DO j=1,nw-1
  	   DO i=1,nwave
  	      w1000=wave(i)*1000.0
  	      IF(w1000>=wu(j)) THEN
  		 EXIT
  	      END IF
  	      tuv2carma(j)=i
  	   END DO
  	END DO
  
  	!---------------------------------------
  	!-extension to 200 Pa using Harrington data
  	prsnz  = (pi01dn(nnzp(1)-1,1) / cp) ** cpor * p00
  	prsnzp = (pi01dn(nnzp(1)  ,1) / cp) ** cpor * p00

  	CALL mclatchyTuv(1,m1,IF_adap,koff(ia,ja),jday  &
  		  ,prsnz,prsnzp  &
  		  ,grid_g(ngrid)%glat	    (1,1)  &
  		  ,grid_g(ngrid)%rtgt	    (1,1)  &
  		  ,grid_g(ngrid)%topt	    (1,1)  &
  		  ,radiate_g(ngrid)%rlongup (1,1)  &
  		  ,zm,zt,prd ,temprd(ia,ja,2:2),dair(ia,ja,2:2),rv , &
  		  zml(ia,ja,2:2),ztl(ia,ja,2:2),do3(ia,ja,2:2),&
  		  dzl(ia,ja,2:2),1,1,rgas,g,stefan,1)
  	!---------------------------------------
  	tuvDriverInit=.true.
  	ALLOCATE(fast_JX_g(ngrids))
  	DO ng=1,ngrids
  	   ALLOCATE(fast_JX_g(ng)%jphoto(nr_photo,mmzp(ng),mmxp(ng),mmyp(ng)) )
  		    fast_JX_g(ng)%jphoto= 0.0d0
  	END DO        
  	   
     END IF
     
     fast_JX_g(ngrid)%jphoto = 0.0D0

     is2DoTuv=.false.
     DO j=ja,jz
  	DO i=ia,iz
  	   !Zenital angle 
  	   sza_(i,j) = dble(acos(radiate_g(ngrid)%cosz(i,j)))*f180PI
  	   IF(abs(sza_(i,j))<=90.0) is2DoTuv=.true.
  	   albedo_(i,j)=radiate_g(ngrid)%albedt(i,j)
  	END DO
     END DO
  
     IF(.not. is2DoTuv) RETURN
     
     CALL mclatchyTuv(2,m1,IF_adap,koff(ia,ja),jday  &
  	  ,prsnz,prsnzp  &
  	  ,grid_g(ngrid)%glat	    (1,1)  &
  	  ,grid_g(ngrid)%rtgt	    (1,1)  &
  	  ,grid_g(ngrid)%topt	    (1,1)  &
  	  ,radiate_g(ngrid)%rlongup (1,1)  &
  	  ,zm,zt,prd ,temprd(ia,ja,:), &
  	  dair(ia,ja,:),rv ,zml(ia,ja,2:2),ztl(ia,ja,2:2), do3(ia,ja,2:2),&
  	  dzl(ia,ja,2:2),1,1,rgas,g,stefan,1)
  	  
     !Doing the vertical levels   
     DO j=ja,jz
  	DO i=ia,iz
  	   k2=grid_g(ngrid)%lpw(i,j)
  	   k1(i,j)=k2-1
  	   koff(i,j)=k2-2
  	   topt(i,j) = grid_g(ngrid)%topt(i,j)
  	   rtgt(i,j) = grid_g(ngrid)%rtgt(i,j)
  	   nrad(i,j) = m1 - 1 + narad - koff(i,j)
  	END DO
     END DO
     ssaaer_=0.0
     DO j=ja,jz
  	DO i=ia,iz
  	   DO k = 1,m1-1-koff(i,j)
  	   
  	      kvert =  k+koff(i,j) + 1
  	   
  	      pird(k)= ( basic_g(ngrid)%  pp(kvert,i,j) + &
  			 basic_g(ngrid)% pi0(kvert,i,j)   ) / cp ! Exner function
  	      !press
  	      prd(k) = pird(k) ** cpor * p00
  	      ! temp (K)
  	      temprd(i,j,k) = dble( basic_g(ngrid)% theta(kvert,i,j) * pird(k) )  
  	      
  	      dair  (i,j,k) = dble( basic_g(ngrid)% dn0(kvert,i,j) )
  	      
  	      rv  (k) = dble( basic_g(ngrid)% rv(kvert,i,j) *  &
  			      basic_g(ngrid)%dn0(kvert,i,j)    )

  	      IF (if_adap == 1) THEN
  		 zml(i,j,k) = zm(k+koff(i,j))
  		 ztl(i,j,k) = zt(k+koff(i,j))
  	      ELSE
  		 zml(i,j,k) = topt(i,j) + zm(k) * rtgt(i,j)
  		 ztl(i,j,k) = topt(i,j) + zt(k) * rtgt(i,j)
  	      ENDIF
  
  	      !-ozone from CTM model (conversion from ppbm to kg/m3)
  	      do3(i,j,k)=chem1_g(O3,ngrid)%sc_p(kvert,i,j)*1.D-9*dair(i,j,k)
  	   END DO
  
   
  	  
  	   CALL mclatchyTuv(3,m1,IF_adap,koff(i,j),jday  &
  		 ,prsnz,prsnzp  			&
  		 ,grid_g(ngrid)%glat	   (i,j)  &
  		 ,rtgt(i,j) &
  		 ,topt(i,j) &
  		 ,radiate_g(ngrid)%rlongup (i,j)  &
  		 ,zm,zt   &
  		 ,prd(1:nrad(i,j))     &
  		 ,temprd(i,j,1:nrad(i,j))  &
  		 ,dair(i,j,1:nrad(i,j))    &
  		 ,rv(1:nrad(i,j))      &
  		 ,zml(i,j,1:nrad(i,j)),ztl(i,j,1:nrad(i,j)) &
  		   ,do3(i,j,1:nrad(i,j)),dzl(i,j,1:nrad(i,j)) &
  		 ,i,j,rgas,g,stefan,nrad(i,j))
  
  	    idaot(i,j) = MAX(MIN(INT(10*((ANINT(10.*carma(ngrid)%aot(i,j,11))/10.)+0.1)/2.),9),1)
  	    DO n=1,nw-1
  		ssaaer_(i,j)=ssaaer_(i,j)+caseW(idaot(i,j),tuv2carma(n))
  	    END DO
  	    ssaaer_(i,j)=ssaaer_(i,j)/(nw-1)
  	END DO
     END DO
  
  
     DO j=ja,jz
  	DO i=ia,iz
  	   DO k = 1,nrad(i,j)
  	      IF(k>1) dzl(i,j,k) = zml(i,j,k) - zml(i,j,k-1)
  	      IF (if_adap == 1) THEN
  		z_(i,j,k)=zml(i,j,k)* 1.e-3 !km
  	      ELSE
  		z_(i,j,k)=zml(i,j,k) * 1.e-3 !km
  	      ENDIF
  	   END DO
  	END DO
     END DO
  
     DO j=ja,jz
  	DO i=ia,iz
  	      zbase(i,j)=zml(i,j,1) * 1.e-3 !unit (km)
  	      ztop(i,j)=zml(i,j,nrad(i,j)) * 1.e-3 !unit (km)
  	      dzl(i,j,1)  = zml(i,j,2) - zml(i,j,1)!unit (m)
  	END DO
     END DO
     
     
     ! -adjust  dzl
     DO j=ja,jz
      DO i=ia,iz
  	 DO k = 1,nrad(i,j)-1
  	  dzl(i,j,k)=dzl(i,j,k+1)
  	  END DO
      END DO
     END DO
    
  
     DO j=ja,jz
  	DO i=ia,iz
  	  DO k = 1,nrad(i,j)
  	      !- #molec[O3]/cm^2	  
  	      co3_(i,j,k)    = do3(i,j,k) * (fatMul/48.00D0)*dzl(i,j,k)*1.D+3*1.d-4 !srf: ok 
  
  	      !- #molec[ar]/cm^2
  	      cair_(i,j,k)   = dair(i,j,k)* (fatMul/28.96D0)*dzl(i,j,k)*1.D+3*1.d-4 !srf: ok 
  	      
  	      !- #molec[ar]/cm^3	  
  	      airden_(i,j,k) = dair(i,j,k) *(fatMul/28.96D0)*1.D+3*1.d-6  !srf: ok 
  		      
  	   END DO
  	END DO
     END DO
     !nz=m1
     DO j=ja,jz
  	DO i=ia,iz
  
  	   tco3_(i,j,nrad(i,j))=co3_(i,j,nrad(i,j))
  	   DO k = nrad(i,j)-1,1,-1
  	      tco3_(i,j,k)=tco3_(i,j,k+1)+co3_(i,j,k)
  	   END DO
  	END DO
     END DO
    
!LFR>   !--------lixo - start 
!LFR>     DO j=ja,jz
!LFR>   	DO i=ia,iz
!LFR>   	   DO k = 1,m1
!LFR>   	   extra3d(22,ngrid)%d3(k,i,j)=co3_(i,j,k)
!LFR>   	   extra3d(23,ngrid)%d3(k,i,j)=cair_(i,j,k)
!LFR>   	   extra3d(24,ngrid)%d3(k,i,j)=airden_(i,j,k)
!LFR>   	   extra3d(25,ngrid)%d3(k,i,j)=tco3_(i,j,k)
!LFR>   	   END DO
!LFR>   	END DO
!LFR>      END DO
!LFR>   !--------lixo - end
  
  !----------- ok start
     IF(so2Present) THEN
  	DO j=ja,jz
  	   DO i=ia,iz
  	      DO k = 2,m1-1-koff(i,j)
  !		 so2col(i,j)=so2col(i,j)+ &
  !			 (chem1_g(iPosSo2,ngrid)%sc_p(k+koff(i,j),i,j)* &
  !			 1.D-9)*cair(i,j,k)*dzl(i,j,k)
  		 so2col_(i,j)=so2col_(i,j)+ &
  			 ( chem1_g(iPosSo2,ngrid)%sc_p(k+koff(i,j),i,j)* 1.D-9) * &
  			 basic_g(ngrid)% dn0(k+koff(i,j),i,j) *& ! kg[NO2]/m^3
  		       (1000.	   /& ! g[SO2]/m^3
  			64.   )    *& !  mol[SO2]/m^3 (64 = molec. weight)
  		       (rtgt(i,j)/dzt(k)) /& !  mol[NO3]/m^2
  		       4.4615D-4  ! Dobson unit
  	      END DO
  	   END DO
  	END DO
     END IF
     IF(no2Present) THEN
       DO j=ja,jz
  	   DO i=ia,iz
  	      DO k = 2,m1-1-koff(i,j)
  		 no2col_(i,j)=no2col_(i,j)+ &
  			(chem1_g(iPosNo2,ngrid)%sc_p(k+koff(i,j),i,j)*1.D-9)* &
  			 basic_g(ngrid)% dn0(k+koff(i,j),i,j) *& ! kg[NO2]/m^3
  			(1000.      /& ! g[NO2]/m^3
  			 46.   )    *& !  mol[NO2]/m^3 (46 = molec. weight)
  			(rtgt(i,j)/dzt(k)) /& !  mol[NO2]/m^2
  			4.4615D-4  ! Dobson unit
  	      END DO
  	   END DO
  	END DO
     END IF
  !----------- ok end	
     
     DO j=ja,jz
  	DO i=ia,iz
  	   DO k = 1,nrad(i,j)-1
  	      tlev_(i,j,k) =  temprd(i,j,k)
  	      tlay_(i,j,k) = (temprd(i,j,k)+temprd(i,j,k+1))/2
  	   END DO
  	   tlev_(i,j,nrad(i,j)) = temprd(i,j,nrad(i,j))
  	   tlay_(i,j,nrad(i,j)) = temprd(i,j,nrad(i,j))
  	END DO
     END DO
    
     DO j=ja,jz
  	DO i=ia,iz
  	   DO k = 1,nlayer!,   nrad(i,j)  
  	      DO w=1,nw-1
  		dtcld_(i,j,k,w)=carma_tuv(ngrid)%g_taucld(tuv2carma(w),k,i,j)
  		omcld_(i,j,k,w)=carma_tuv(ngrid)%g_wcld  (tuv2carma(w),k,i,j)
  		gcld_ (i,j,k,w)=carma_tuv(ngrid)%g_gcld  (tuv2carma(w),k,i,j)
  		dtaer_(i,j,k,w)=carma_tuv(ngrid)%g_tauaer(tuv2carma(w),k,i,j)
  		omaer_(i,j,k,w)=carma_tuv(ngrid)%g_wol   (tuv2carma(w),k,i,j)
  		gaer_ (i,j,k,w)=carma_tuv(ngrid)%g_gol   (tuv2carma(w),k,i,j)  
  	      END DO
  	   END DO
  	   DO k=nlayer+1,nrad(i,j)+1
  		dtcld_(i,j,k,:)=0.
  		omcld_(i,j,k,:)=0.
  		gcld_ (i,j,k,:)=0.
  		dtaer_(i,j,k,:)=0.
  		omaer_(i,j,k,:)=0.
  		gaer_ (i,j,k,:)=0.    
  	   END DO
  	END DO
     END DO
     
       IF(Is2PrintIn) THEN
  	  DO j=ja,jz
  	     DO i=ia,iz
  		rshort(i,j)=radiate_g(ngrid)%rshort(i,j)
  	     END DO
  	  END DO
  	  IF(mod(time+0.001,1800.0)<dtlt) THEN
  	     WRITE(cmynum,FMT='(I4.4)') mynum
  	     WRITE(ctime,FMT='(I8.8)') int(time)
  	     CALL ctlIn3d(ia,iz,ja,jz,kz,kj,nReact,cMyNum,cTime,jjlabel)
  	     OPEN(19,file='input_3d_P'//cmynum//'-'//ctime//'s.gra',		   &
  		  form='unformatted',access='direct',status='unknown',  &
  		  recl=7*4*((iz-ia+1)*(jz-ja+1)*kz))
  	     nrec=1
  	     WRITE(19,rec=nrec) tlev_,tlay_,airDen_,cair_,co3_,tco3_,z_
  	     CLOSE(19)
  
  	     CALL ctlIn2d(ia,iz,ja,jz,kz,kj,nReact,cMyNum,cTime,jjlabel)
  	     OPEN(19,file='input_2d_P'//cmynum//'-'//ctime//'s.gra',		   &
  		  form='unformatted',access='direct',status='unknown',  &
  		  recl=8*4*((iz-ia+1)*(jz-ja+1)))
  	     nrec=1
  	     WRITE(19,rec=nrec) zbase,ztop,so2col_,no2col_,sza_, &
  				albedo_,rshort,ssaaer_
  	     CLOSE(19)
  	  END IF
       END IF
  
      !Calculate the number of blocks for blockSize and
      !subgrid domain
      CALL AllocIndex(blockSize,ia,ja,iz,jz,sza_(ia:iz,ja:jz),.true.)
  
      !For each block
      DO nOfBlock=1,nob
  
  	 !Allocating internal data structure
  	 ALLOCATE(nz(block_End(nOfBlock)))
  	 ALLOCATE(sza(block_End(nOfBlock)))
  	 ALLOCATE(zLevel(block_End(nOfBlock),kz))
  	 ALLOCATE(tLev(block_End(nOfBlock),kz))
  	 ALLOCATE(tLay(block_End(nOfBlock),kz))
  	 ALLOCATE(airDen(block_End(nOfBlock),kz))
  	 ALLOCATE(cAir(block_End(nOfBlock),kz))
  	 ALLOCATE(cO3(block_End(nOfBlock),kz))
  	 ALLOCATE(tcO3(block_End(nOfBlock),kz))
  	 ALLOCATE(albedo(block_End(nOfBlock),kw))
  	 ALLOCATE(so2col(block_End(nOfBlock)))
  	 ALLOCATE(no2col(block_End(nOfBlock)))
  	 ALLOCATE(dtCld(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(omCld(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(gCld(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(dtAer(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(omAer(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(gAer(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(rate(block_End(nOfBlock),ks,kz))
  	 ALLOCATE(valJ(block_End(nOfBlock),kj,kz))
  	 ALLOCATE(sirRad(block_End(nOfBlock),kz,kw))
  	 ALLOCATE(saFlux(block_End(nOfBlock),kz,kw))
  
  	 !Copying data from input variables to block structure       
  	 DO iob=1,block_End(nOfBlock)
  	    iaux=indexi(iob,nOfBlock)
  	    jaux=indexj(iob,nOfBlock)
  	    nz(iob) = nrad(iaux,jaux)
  	    sza(iob)=sza_(iaux,jaux)
  	    so2col(iob)=so2col_(iaux,jaux)
  	    no2col(iob)=no2col_(iaux,jaux)
  	    !taucld(iob)=taucld_(iaux,jaux)
  	    DO izz=1,kz
  	       zLevel(iob,izz)=z_(iaux,jaux,izz)
  	       tLev(iob,izz)=tlev_(iaux,jaux,izz)
  	       tLay(iob,izz)=tlay_(iaux,jaux,izz)
  	       airDen(iob,izz)=airDen_(iaux,jaux,izz)
  	       cAir(iob,izz)=cAir_(iaux,jaux,izz)
  	       cO3(iob,izz)=co3_(iaux,jaux,izz)
  	       tcO3(iob,izz)=tco3_(iaux,jaux,izz)
  	       DO iw=1,kw
  		  dtCld(iob,izz,iw)=dtcld_(iaux,jaux,izz,iw)
  		  omCld(iob,izz,iw)=omcld_(iaux,jaux,izz,iw)
  		  gCld(iob,izz,iw)=gcld_(iaux,jaux,izz,iw)
  		  dtAer(iob,izz,iw)=dtaer_(iaux,jaux,izz,iw)
  		  omAer(iob,izz,iw)=omaer_(iaux,jaux,izz,iw)
  		  gAer(iob,izz,iw)=gaer_(iaux,jaux,izz,iw)
  	       END DO
  	    END DO
  	    DO iw=1,kw
  	       albedo(iob,iw)=albedo_(iaux,jaux)
  	    END DO
  	 END DO !
  
  	 CALL Tuv( &
  	    mynum,     & ! Number of this processor
  	    block_End(nOfBlock), & ! Size of each column  
  	    nstr,      & ! number of radiation streams 
  	    nz,        & ! number of vertical levels, equally spaced
  	    maxZ,      & ! Highest possible vertical level
  	    zLevel,    & ! [kz] altitude for each level [km]
  	    nwint,     & ! number of wavelength intervals, equally spaced
  	    sza,       & ! Solar zenith angle and azimuth
  	    albedo,    & ! surface albedo, wavelength independent
  	    so2col,    & ! Total columns of SO2 (Dobson Units)
  	    no2col,    & ! Total columns of NO2 (Dobson Units)
  	    dtcld,     & ! optical depth due to absorption by clouds at each altitude and wavelength 
  	    omcld,     & ! single scattering albedo due to clouds at each defined altitude and wavelength
  	    gcld ,     & ! cloud asymmetry factor at each defined altitude and wavelength
  	    dtaer,     & ! optical depth due to absorption by aerosols at each altitude and wavelength
  	    omaer,     & ! single scattering albedo due to aerosols at each defined altitude and wavelength
  	    gaer ,     & ! aerosol asymmetry factor at each defined altitude and wavelength
  	    alpha,     & ! Angstrom alpha 
  	    dirsun,    & ! direct sun
  	    difdn,     & ! down-welling diffuse
  	    difup,     & ! up-welling diffuse
  	    tlev,      & ! [kz] temperature [K] at each specified altitude level 
  	    tlay,      & ! [kz] temperature [K] at each specified altitude layer
  	    airden,    & ! [kz] air density [molec/cc] at each specified altitude
  	    cair,      & ! [kz] number of air molecules per cm^2 at each altitude
  	    co3,       & ! [kz] Total of molec O3 cm-2
  	    tco3,      & ! [kz] Total column o3 - molec cm-2
  	    esfact,    & ! sun-earth distance UA
  	    .FALSE.,  & ! To print a debug on each column			      &
  	    rate,      & ! Weighted irradiances (dose rates) [W m-2]	
  	    valj,   & ! Photolysis coefficients (j-values)		  
  	    sirrad,    & ! Spectral irradiance, [W m-2 nm-1]		  
  	    saflux     & ! Spectral actinic flux, [quanta s-1 nm-1 cm-2]
  	    )
  	  
  	 DO iob=1,block_End(nOfBlock)
  	    ii=indexi(iob,nOfBlock)
  	    jj=indexj(iob,nOfBlock)    
  	    !Copying from internal to external data structure
  	    rate_(ii,jj,:,:)	  = rate(iob,:,:) 
  	    valjLoc(ii,jj,:,:)      = DBLE(valJ(iob,:,:))
	    sirrad_(ii,jj,:,:)    = sirRad(iob,:,:)
  	    saflux_(ii,jj,:,:)    = saFlux(iob,:,:)
  	 END DO !iob
  
  
  	 DEALLOCATE(nz)
  	 DEALLOCATE(sza)
  	 DEALLOCATE(zLevel)
  	 DEALLOCATE(tLev) 
  	 DEALLOCATE(tLay) 
  	 DEALLOCATE(airDen)
  	 DEALLOCATE(cAir) 
  	 DEALLOCATE(cO3)  
  	 DEALLOCATE(tcO3) 
  	 DEALLOCATE(albedo)
  	 DEALLOCATE(so2col)
  	 DEALLOCATE(no2col)
  	 DEALLOCATE(dtCld)	  
  	 DEALLOCATE(omCld)	  
  	 DEALLOCATE(gCld) 
  	 DEALLOCATE(dtAer)	  
  	 DEALLOCATE(omAer)	  
  	 DEALLOCATE(gAer) 
  	 DEALLOCATE(rate)
  	 DEALLOCATE(valJ)
  	 DEALLOCATE(sirRad)
  	 DEALLOCATE(saFlux)
  
      END DO !Blocks
  
      CALL AllocIndex(blockSize,ia,ja,iz,jz,sza_(ia:iz,ja:jz),.false.)
  
      sslabel=slabel
      nnj=nj
    
      !Putting the photolises values into the rigth place 
      nReact=0
      DO k=1,kj  
  	IF (xref(k)==0) CYCLE  
!--------lixo - start 
    !------
    !print*,' converting: ',k,xref(k), real(maxval(valJLoc(:,:,k,:))),real(minval(valJLoc(:,:,k,:)))
    !call flush(6)
    !------
!--------lixo - end 
  	   jjlabel(xRef(k))=jlabel(k)
  	    nReact=nReact+1
  	    DO j=ja,jz
  	       DO i=ia,iz
  		  DO m=1,m1-1
  		     valj_(i,j,xRef(k),m)=valJLoc(i,j,k,m)	       
  		     fast_JX_g(ngrid)%jphoto(xRef(k),m+1,i,j)=valJLoc(i,j,k,m)         
	     
!--------lixo - start 
!	     !-----------------------------
!	     if(valJLoc(i,j,k,m) < 0.) then
!	       print*,' J negative for: ',i,j,k,m
!	       print*,' J value= ',valJLoc(i,j,k,m);call flush(6)
!	     endif
!	     !-----------------------------
!--------lixo - end 
  		  END DO
  		  fast_JX_g(ngrid)%jphoto(xRef(k),1,i,j)= &
  				  fast_JX_g(ngrid)%jphoto(xRef(k),2,i,j)
  	    END DO
       END DO
  
    END DO
    
    
    IF(TRIM(chemical_mechanism) == 'CB07') THEN 
       !for CB07: reaction 15 = reaction 14
       fast_JX_g(ngrid)%jphoto(15,:,:,:)=fast_JX_g(ngrid)%jphoto(14,:,:,:)
       
       !-----------
       !-----------
       !
       !fast_JX_g(ngrid)%jphoto(2,:,:,:)=0.5*fast_JX_g(ngrid)%jphoto(2,:,:,:)
       !fast_JX_g(ngrid)%jphoto(3,:,:,:)=0.5*fast_JX_g(ngrid)%jphoto(3,:,:,:)
       !-----------
       !-----------
   END IF

   IF(trim(chemical_mechanism) == 'RACM') THEN

       fast_JX_g(ngrid)%jphoto(15,:,:,:)=0.28*fast_JX_g(ngrid)%jphoto(9,:,:,:)

       fast_JX_g(ngrid)%jphoto(20,:,:,:)=0.20*fast_JX_g(ngrid)%jphoto(1,:,:,:)

  
   ENDIF    
    
    IF(Is2PrintOut) THEN
       IF(mod(time+0.001,1800.0)<dtlt) THEN
  	  WRITE(cmynum,FMT='(I4.4)') mynum
  	  WRITE(ctime,FMT='(I8.8)') int(time)
  	  CALL ctlOut(ia,iz,ja,jz,m1,kj,nReact,cMyNum,cTime,jjlabel)
  	  OPEN(19,file='photoj_PW'//cmynum//'-'//ctime//'s.gra',   &
  		form='unformatted',access='direct',status='unknown',  &
  	       recl= 4*((iz-ia+1)*(jz-ja+1)*1))
  	  nrec = 0
  	  DO i=1,14
  	     DO k=1,m1
  		nrec=nrec +1
  		WRITE(19,rec=nrec) real(fast_JX_g(ngrid)%jphoto(i,k,ia:iz,ja:jz))
  	     END DO
  	  END DO
  	  DO i=1,kj
  	     !print*, 'reac=',i,xref(i); call flush(6)
  	     IF (xref(i)==0) CYCLE
  	     DO k=1,m1
  		nrec=nrec +1
  		WRITE(19,rec=nrec) real(valJLoc(ia:iz,ja:jz,i,k))
  	     END DO	  
  	  END DO
  	  CLOSE(19)
       END IF	
    END IF  
    
  END SUBROUTINE tuvDriver
  
  SUBROUTINE InitTuvDriver
    no2Present=.false.
    so2Present=.false.
    iPosNo2=0
    iPosSo2=0
    tuvDriverInit=.false. 
  END SUBROUTINE InitTuvDriver
  
  SUBROUTINE ctlOut(ia,iz,ja,jz,m1,kj,nReact,cMyNum,cTime,jjlabel)
    USE mem_grid, ONLY: grid_g,ngrid
    INTEGER,INTENT(IN) :: ia,iz,ja,jz,m1,nReact,kj
    CHARACTER(LEN=4), INTENT(IN) :: cMyNum
    CHARACTER(LEN=8), INTENT(IN) :: cTime
    CHARACTER(LEN=50),INTENT(IN) :: jjlabel(kj)
    CHARACTER(LEN=3) :: cnReact
    INTEGER :: i
    
    OPEN(19,FILE='photoj_PW'//cMyNum//'-'//cTime//'s.ctl')
    WRITE (19,FMT='(A)') 'dset ^photoj_PW'//cMyNum//'-'//cTime//'s.gra'
  !  WRITE (19,FMT='(A)') 'options sequential'
    WRITE (19,FMT='(A)') 'undef -9.99e33'
    WRITE (19,FMT='(A)') 'title Photolisys'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'xdef ',(iz-ia+1),' linear    ',grid_g(ngrid)%glon(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'ydef ',(jz-ja+1),' linear    ',grid_g(ngrid)%glat(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,I4,A)') 'zdef ',m1,' linear    ',1,'   1'
    WRITE (19,FMT='(A)') 'tdef    1	  linear 00:00z01jan2000	 1hr'
    WRITE (19,FMT='(A,I3.3)') 'vars ',nReact
    DO i=1,nReact
  	WRITE(cnReact,FMT='(I3.3)') i
  	WRITE (19,FMT='(A,I4.4,A)') 'React'//cNReact//'    ',m1,'  100  '//trim(jjlabel(i))
  	CALL flush(19)
    END DO
    WRITE (19,FMT='(A)') 'endvars'
    CLOSE(19)
  
  END SUBROUTINE ctlOut

  SUBROUTINE ctlIn3d(ia,iz,ja,jz,kz,kj,nReact,cMyNum,cTime,jjlabel)
    USE mem_grid, ONLY: grid_g,ngrid
    INTEGER,INTENT(IN) :: ia,iz,ja,jz,kz,nReact,kj
    CHARACTER(LEN=4), INTENT(IN) :: cMyNum
    CHARACTER(LEN=8), INTENT(IN) :: cTime
    CHARACTER(LEN=50),INTENT(IN) :: jjlabel(kj)
    CHARACTER(LEN=3) :: cnReact
    INTEGER :: i
    
    OPEN(19,FILE='input_3d_P'//cMyNum//'-'//cTime//'s.ctl')
    WRITE (19,FMT='(A)') 'dset ^input_3d_P'//cMyNum//'-'//cTime//'s.gra'
    !WRITE (19,FMT='(A)') 'options sequential'
    WRITE (19,FMT='(A)') 'undef -9.99e33'
    WRITE (19,FMT='(A)') 'title Input Vars'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'xdef ',(iz-ia+1),' linear    ',grid_g(ngrid)%glon(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'ydef ',(jz-ja+1),' linear    ',grid_g(ngrid)%glat(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,I4,A)') 'zdef ',kz,' linear    ',1,'   1'
    WRITE (19,FMT='(A)') 'tdef    1	  linear 00:00z01jan2000	 1hr'
    WRITE (19,FMT='(A,I3.3)') 'vars ',7
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'tlev',kz,  '  100  Temperature'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'tlay',kz,  '  100  Temperature'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'airDen',kz,'  100  Air Density'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'cair',kz,  '  100  Air Molecules'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'co3',kz,	'  100  CO3 Molecules '
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'tco3',kz,  '  100  Total CO3 in colunm'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'z',kz,  '  100  Altitude in km'
    WRITE (19,FMT='(A)') 'endvars'
    CALL flush(19)
    CLOSE(19)
  END SUBROUTINE ctlIn3d
  
  SUBROUTINE ctlIn2d(ia,iz,ja,jz,kz,kj,nReact,cMyNum,cTime,jjlabel)
    USE mem_grid, ONLY: grid_g,ngrid
    INTEGER,INTENT(IN) :: ia,iz,ja,jz,kz,nReact,kj
    CHARACTER(LEN=4), INTENT(IN) :: cMyNum
    CHARACTER(LEN=8), INTENT(IN) :: cTime
    CHARACTER(LEN=50),INTENT(IN) :: jjlabel(kj)
    CHARACTER(LEN=3) :: cnReact
    INTEGER :: i
    
    OPEN(19,FILE='input_2d_P'//cMyNum//'-'//cTime//'s.ctl')
    WRITE (19,FMT='(A)') 'dset ^input_2d_P'//cMyNum//'-'//cTime//'s.gra'
    !WRITE (19,FMT='(A)') 'options sequential'
    WRITE (19,FMT='(A)') 'undef -9.99e33'
    WRITE (19,FMT='(A)') 'title Input Vars'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'xdef ',(iz-ia+1),' linear    ',grid_g(ngrid)%glon(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,F7.2,A)') 'ydef ',(jz-ja+1),' linear    ',grid_g(ngrid)%glat(ia,ja),'   1'
    WRITE (19,FMT='(A,I4.4,A,I4,A)') 'zdef ',1,' linear    ',1,'   1'
    WRITE (19,FMT='(A)') 'tdef    1	  linear 00:00z01jan2000	 1hr'
    WRITE (19,FMT='(A,I3.3)') 'vars ',8
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'zbase',1,  '  100  Altitude base'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'ztop',1,  '  100  Altitude top'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'so2col',1,'  100  SO2 colunmn'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'no2col',1,  '  100  NO2 column'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'sza',1,   '  100  Zenith angle'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'albedo',1,  '  100  Surface albedo'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'rshort',1,  '  100  Surface albedo'
    WRITE (19,FMT='(A6,3X,I4.4,A)') 'ssaaer',1,  '  100  Single Scater. albedo'
    WRITE (19,FMT='(A)') 'endvars'
    CALL flush(19)
    CLOSE(19)
  
  END SUBROUTINE ctlIn2d
  
    SUBROUTINE mclatchyTuv(iaction,m1,if_adap,koff,jday  &
  	 ,prsnz,prsnzp,glat,rtgt,topt,rlongup  &
  	 ,zm,zt,pl,tl,dl,rl,zml,ztl,o3l,dzl, &
  	 iPos,jPos,rgas,g,stefan,nZRad)
    
      INTEGER,INTENT(IN) :: iaction
      INTEGER,INTENT(IN) :: m1
      INTEGER,INTENT(IN) :: if_adap
      INTEGER,INTENT(IN) :: koff
      INTEGER,INTENT(IN) :: jday
      INTEGER,INTENT(IN) :: nZRad
      REAL,   INTENT(IN) :: prsnz
      REAL,   INTENT(IN) :: prsnzp
      REAL,   INTENT(IN) :: glat
      REAL,   INTENT(IN) :: rtgt
      REAL,   INTENT(IN) :: topt
      REAL,   INTENT(IN) :: rlongup
      REAL,   INTENT(IN) :: zm(m1)	
      REAL,   INTENT(IN) :: zt(m1)    
      REAL,   INTENT(IN) :: rgas,g,stefan   
      INTEGER,INTENT(IN) :: iPos,jPos
      
      DOUBLE PRECISION, INTENT(INOUT) :: zml(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: ztl(nZRad)  
      DOUBLE PRECISION, INTENT(INOUT) :: pl(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: tl(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: dl(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: rl(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: o3l(nZRad)
      DOUBLE PRECISION, INTENT(INOUT) :: dzl(nZRad)  
    
      REAL :: wtnorth,wtsouth,wt,fjday,wtjul,wtjan
      INTEGER :: k,lv,ls,lf,lats,latn,lat
      INTEGER :: isummer,iwinter,is,ind,index,ilev,ifld
    
      REAL, DIMENSION(33,9,6) :: mclat
      REAL, DIMENSION(33,6) :: mcol
      
      INTEGER, PARAMETER :: namax=10

      !CHARACTER(len=) :: title
  
    
      ! field # from Mclatchy Soundings
      !    1	  : Height (m)
      !    2	  : pressure (Pa)
      !    3	  : potential temp (K)
      !    4	  : vapor density (kg/m^3)
      !    5	  : ozone density (kg/m^3)
      !    6	  : air density (kg/m^3)
    
      IF (iaction == 1) THEN
    
  	 rgasog = rgas / g
    
  	 ! Copy (since no time interpolation needed) tropical sounding to 
  	 ! mclat array
  	 ! (done only once on each node).
    
  	 DO lv = 1,33
  	    DO lf = 1,6
  	       mclat(lv,5,lf) = mcdat(lv,9,lf)
  	      ! if(lf==2) PRINT*,' press=',lv, mcdat(lv,9,lf),mcdat(lv,9,1)
  	    END DO
  	 END DO
    
  	 ! Compute number of levels to be added above model top from
  	 ! Mclatchy soundings.
  	 ! Base this number on prsnz and prsnzp, which was earlier computed from
  	 ! PI01DN(NNZP(1),1), so that it is the same for all compute nodes
  	 ! (done only once on each node).
  	 
  	 IF (prsnz < 3000.) THEN
    
  	    ! If prsnz, the pressure at the highest model prognostic level, is less
  	    ! than 3000 Pa, do not add any levels.
    
  	    narad = 0
    
  	 ELSE
    
  	    ! If prsnzp is greater than 3000 Pa, add one or more radiation levels.
  	    ! Make the top level be 200 Pa.
    
  	    !srf-changed from 1500 to 200 Pa
  	    deltap = max(200.,  &
  		 2.*(prsnz-prsnzp),  &
  		 (prsnz-200.1)/float(namax))
  	    narad = max(1,int((prsnz-200.)/deltap))
    
  	 END IF
    
  	! PRINT *, "DEBUG-ALF:rad_mclat_sx6.f90:mclatchy"
  	! PRINT *, "prsnz,deltap,narad=", prsnz, deltap, narad,namax
  	! CALL FLUSH(6)
  	! STOP 333
    ELSE IF (iaction == 2) THEN

       ! Interpolate arctic, sub-arctic, mid-latitude, and subtropical, Mclatchy
       ! soundings between summer and winter values by time of year using cosine
       ! function.  Assume that extreme values occur on
       ! January 16 and 1/2 year later.
       ! (Done once per grid/node each radiation time.)
  
       fjday = float(jday)
       wtjan = 0.5 * (1. + cos(6.283185 * (fjday-16.) / 365.))
       wtjul = 1. - wtjan
  
       DO lats = 1,4
  	  latn = 10 - lats
  	  isummer = 2 * lats
  	  iwinter = isummer - 1
  	  DO lv = 1,33
  	     DO lf = 1,6
  		mclat(lv,lats,lf) = wtjan * mcdat(lv,isummer,lf)  &
  		     + wtjul * mcdat(lv,iwinter,lf)
  		mclat(lv,latn,lf) = wtjan * mcdat(lv,iwinter,lf)  &
  		     + wtjul * mcdat(lv,isummer,lf)
  	     END DO
  	  END DO
       END DO
  
     !     ! Adjust solar fluxes at top of atmosphere by current Earth-Sun distance!!
     !
     !     do is = 1,nsolb
     !        solar1(is) = solar0(is) * solfac
     !     END DO
  
    ELSE IF (iaction == 3) THEN
  
       ! At this point, subtropical, mid-latitude, sub-arctic,
       ! and arctic Mclatchy soundings have been interpolated between summer
       ! and winter values by time of year.  In this section of code,
       ! interpolate these 4 plus the all-year tropical sounding by latitude
  	!for the current i,j column in the grid.
  
       DO ind = 1,11
  	  index = ind
  	  ! IF (glat .LT. slat(index+1)) go to 10  ! Mod.by ALF
  	  IF (glat < slat(index+1)) exit	   ! Mod.by ALF
       END DO
  
  
       lat = latind(index)
  
       IF (index .eq. 1 .or. index .eq. 6 .or. index .eq. 11) THEN
  
  	  ! For pure arctic or tropical latitudes, assign sounding values without
  	  ! interpolation.
  
  	  DO lv = 1,33
  	     DO lf = 1,6
  		mcol(lv,lf) = mclat(lv,lat,lf)
  	     END DO
  	  END DO
  
       ELSE
  
  	  ! For other latitudes, linearly interpolate between soundings according
  	  ! to latitude bands defined in array `slat'.
  
  	  wtnorth = (glat - slat(index)) / (slat(index + 1) - slat(index))
  	  wtsouth = 1. - wtnorth
  	  DO lv = 1,33
  	     DO lf = 1,6
  		mcol(lv,lf) = wtsouth * mclat(lv,lat,lf)  &
  		     + wtnorth * mclat(lv,lat+1,lf)
  	     END DO
  	  END DO
       END IF
  
       ! Fill radiation column arrays (other than o3l) with variables from
       ! the model grid.
  
     !     do k = 1,m1-1-koff
     !        if (if_adap == 1) THEN
     !  	 zml(k) = zm(k+koff)
     !  	 ztl(k) = zt(k+koff)
     !        ELSE
     !  	 zml(k) = topt + zm(k) * rtgt
     !  	 ztl(k) = topt + zt(k) * rtgt
     !        END IF
     !
     !        pl(k) = press(k+koff)
     !        tl(k) = tair(k+koff)
     !        dl(k) = dn0(k+koff)
     !        rl(k) = rv(k+koff) * dn0(k+koff)
     !     END DO
  
       ! DEBUG-ALF
       !PRINT *, "DEBUG-ALF: narad=", narad
       !CALL FLUSH(6)
  
       ! Modif. by ALF-Sfreitas
       ! Original: deltap = (pl(m1-1-koff) - 1500.) / float(narad)
  
       IF (narad /= 0) THEN !IF (prsnz >= 3000.) THEN
  
     !1500Pa	    deltap = (pl(m1-1-koff) - 1500.) / float(narad)
  	  deltap = (pl(m1-1-koff) - 200.) / float(narad)
  
       ELSE
  
  	  deltap = 0.
  
       END IF
       DO k = m1-koff,nZRad
  	  pl(k) = pl(k-1) - deltap
       END DO
  
       ! Interpolate O3 from Mclatchy sounding to all levels in radiation column,
       ! and interpolate other variables (temperature, density,
       !vapor mixing ratio) to added levels.
  
       
       lv = 1
     !     do k = 1,nZRad	   ! use este para preencher toda a coluna de ozonio com valores climatologicos
       DO k = m1-koff,nZRad	! use este para preencher com valores do modelo de transporte e  com valores climatologicos
  			       ! na camada acima do modelo
  	  DO			       
  	     IF (pl(k) .gt. mcol(1,2)) THEN
  		o3l(k) = mcol(1,5)
  		IF (k .ge. m1-koff) THEN
  		   tl(k) = mcol(1,3)
  		   rl(k) = mcol(1,4)
  		   dl(k) = mcol(1,6)
  		END IF
  		EXIT
  	     ELSE IF (pl(k) .le. mcol(lv,2) .and. pl(k) .ge. mcol(lv+1,2)) THEN
  		wt = (pl(k) - mcol(lv,2)) / (mcol(lv+1,2) - mcol(lv,2))
  		o3l(k) = mcol(lv,5) + (mcol(lv+1,5) - mcol(lv,5)) * wt
  		IF (k .ge. m1-koff) THEN
  		   tl(k) = mcol(lv,3) + (mcol(lv+1,3) - mcol(lv,3)) * wt
  		   rl(k) = mcol(lv,4) + (mcol(lv+1,4) - mcol(lv,4)) * wt
  		   dl(k) = mcol(lv,6) + (mcol(lv+1,6) - mcol(lv,6)) * wt
  		END IF
  		EXIT
  	     ELSE IF (pl(k) .lt. mcol(33,2)) THEN
  		o3l(k) = mcol(33,5)
  		IF (k .ge. m1-koff) THEN
  		   tl(k) = mcol(33,3)
  		   rl(k) = mcol(33,4)
  		   dl(k) = mcol(33,6)
  		END IF
  		EXIT
  	     ELSE IF(pl(k) .lt. mcol(lv+1,2)) THEN
  		lv = lv + 1
  		IF (lv .ge. 33) THEN
  		   PRINT*, 'Lv greater or equal 33';CALL flush(6)
  		   STOP 'mclat1_fastjx'
  		END IF
  		CYCLE
  	     ELSE
  		PRINT*, 'pressure data improperly ordered';CALL flush(6)
  		STOP 'mclat2_fastjx'
  	     END IF
  	 END DO
       END DO
  
  
       ! Compute heights of added levels by hydrostatic integration.
  
       DO k = m1-koff,nZRad
  
  	  ztl(k) = ztl(k-1) + rgasog * (tl(k-1) - tl(k)  &
  	       + (pl(k-1) * tl(k) - pl(k) * tl(k-1)) / (pl(k) - pl(k-1))  &
  	       * log(pl(k)/pl(k-1)))
  	  zml(k-1) = .5 * (ztl(k) + ztl(k-1))
       END DO
       zml(nZRad-koff) = 2. * ztl(nZRad-koff) - zml(nZRad-1-koff)
  
       ! Compute dzl values.
  
       DO k = 2,nZRad
  	  dzl(k) = zml(k) - zml(k-1)
       END DO
       dzl(1)  = zml(2)
  
       ! Fill surface values
  
       !   pl(1) = .5 * (press(1+koff) + press(2+koff))
     !     pl(1) = press(2+koff) + (zm(1+koff) - zt(3+koff))  &
     !  	/ (zt(2+koff) - zt(3+koff)) * (press(2+koff) - press(3+koff))
       pl(1) = pl(2+koff) + (zm(1+koff) - zt(3+koff))  &
  	    / (zt(2+koff) - zt(3+koff)) * (pl(2+koff) - pl(3+koff))
       tl(1) = sqrt(sqrt(rlongup / stefan))
  
    END IF

  END SUBROUTINE mclatchyTuv
  
  SUBROUTINE AllocIndex(block_size,ia,ja,iz,jz,sza,Is2Alloc)
  	IMPLICIT NONE
  	INTEGER,INTENT(IN) :: block_size,ia,iz,ja,jz
  	REAL,DIMENSION(ia:iz,ja:jz),INTENT(IN) :: sza
  	LOGICAL :: Is2Alloc
  	INTEGER :: i1,j1,inb
  	INTEGER :: resto,ij,totalCol
  	INTEGER(KIND=8) :: totType 
  	REAL :: eps    
    
  	!If is to allocate index
  	IF(Is2Alloc) THEN  
  	  !Calculanting the ammount of columns
  	  ij=0
  	  DO j1=ja,jz
  	    DO i1=ia,iz
  	       IF( abs(sza(i1,j1))<0.0 .OR. abs(sza(i1,j1))>=90.0) CYCLE
  	       ij=ij+1
  	    END DO
  	  END DO
  	  totalCol=ij
  	  !If the ammount of columns is less than block_size
  	  IF(block_size>=ij) THEN
  	    nob=1		  !Number of blocks is 1
  	    ALLOCATE(block_end(1))
  	    block_end(1)=ij
  	  !If the ammount of columns is more than block_size
  	  !we'll need more than 1 block
  	  ELSE
  	    nob=ij/block_size		 !Calculating the ammount of blocks
  	    resto=ij-(nob*block_size)
  	    IF(resto==0) THEN		 !If is exact 
  	       ALLOCATE(block_end(nob))  !Allocate nob blocks
  	       block_end=block_size	 !All the blocks has the same size
  	    ELSE
  	       nob=nob+1		 !If not increase the nob
  	       ALLOCATE(block_end(nob))  ! and allocate
  	       block_end=block_size	 !All the blocks has the same size
  	       block_end(nob)=resto	 !except the last one.
  	    END IF
  	 END IF
  	 maxblock_size=maxval(block_end) !The greatest block size
  
  	 !Allocating index for the columns
  	 ALLOCATE(indexi(maxblock_size,nob))
  	 ALLOCATE(indexj(maxblock_size,nob))
  	 ALLOCATE(ijindex(ia:iz,ja:jz))
  	 ALLOCATE(bindex(ia:iz,ja:jz))
  	 ijindex=0
  	 ij=0
  	 inb=1
  	 !Performing a crossreference beteween index and real position
  	 !In a,j position
  	 DO j1=ja,jz
  	   DO i1=ia,iz
  	      IF(abs(sza(i1,j1))<0.0 .OR. abs(sza(i1,j1))>=90.0) CYCLE
  	      ij=ij+1
  	      IF(ij>block_end(inb)) THEN
  		ij=1
  		inb=inb+1
  	      END IF		
  	      indexi(ij,inb)=i1
  	      indexj(ij,inb)=j1
  	      ijindex(i1,j1)=ij
  	      bindex(i1,j1)=inb
  	    END DO
  	  END DO
  	!If is to deallocate index
  	ELSE
  	  DEALLOCATE(block_end)
  	  DEALLOCATE(indexi)
  	  DEALLOCATE(indexj)
  	  DEALLOCATE(ijindex)
  	  DEALLOCATE(bindex)
  	END IF

  	!If you want dump 
  	IF( .NOT. dumpXReference) RETURN
  
  	WRITE (*,FMT='(A)') '============ Dump of memory structure in blocks' //&
  			    ' ============'
  	WRITE (*,FMT='(A,4(I3.3,1X))') 'Boundaries	 : ',ia,iz,ja,jz    
  	WRITE (*,FMT='(A,I6.6)') 'Total of Columns : ',totalCol    
  	WRITE (*,FMT='(A,I3.3)') 'Ammount of blocks: ',nob
  	WRITE (*,FMT='(A,I3.3)') 'Block Size	   : ',block_size
  	WRITE (*,FMT='(A,I3.3)') 'Minor block	   : ',resto	
  	WRITE (*,FMT='(A)') 'Crossreference x,y -> ij,block:'
  	WRITE (*,FMT='(4(A3,1X))') 'i1','j1','ij','nob'
  	DO j1=ja,jz
  	   DO i1=ia,iz
  	      WRITE (*,FMT='(4(I3.3,1X))') i1,j1,ijindex(i1,j1),bindex(i1,j1)
  	   END DO
  	END DO
!!	WRITE (*,FMT='(A)') 'Crossreference ij,block -> x,y:'
      WRITE (*,FMT='(4(A3,1X))') 'nob','ij','i1','j1'
      DO inb=1,nob
         DO ij=1,block_end(inb)
	    WRITE (*,FMT='(4(I3.3,1X))') inb,ij,indexi(ij,inb),indexj(ij,inb)
	 END DO
      END DO
   END SUBROUTINE AllocIndex



END MODULE ModtuvDriver
